HPAVC/HPAVC CD-ROM.iso/PRUS101.ZIP/FSPEAKER.PAS

Pascal/Delphi Source File | 1994-12-19 | 25KB | 1,016 lines

Unit FSpeaker; { FIDO unit: Handling of and sound effects for the PC speaker }
 (***************************************************************************

           RELEASE 1.04 - as first contained in the file PRUS101.LZH
                 by Orazio Czerwenka, 2:2450/540.55,  GERMANY

                 --------------------------------------------
                  organized for Fido's PASCAL related echoes
                 --------------------------------------------

     06/07/1994 to 07/04/1994 by Orazio Czerwenka, 2:2450/540.55, GERMANY
     07/05/1994 to 07/15/1994 by Wolfram Sieber,   2:2453/90.6,   GERMANY
     07/16/1994 to --/--/---- by Orazio Czerwenka, 2:2450/540.55, GERMANY

     ====================================================================

      Currently there is nobody who is interrested in further supporting
      this unit as the 'unit's current organizer', even though there are
      still some useful routines missing for those who excessivly want
      to use PC speaker sounds in there own programs.

      Probably Pawel Ostapczuk will take over this part for future
      releases, but we don't know that definitely by now.

      So if you've got yourself any more useful source you wish to
      contribute to this unit or are interessted in becoming its new
      'current organizer' send your sources or mails to the projects
      'current' general supervisor:

                --------------------------------------------
                  Orazio Czerwenka, 2:2450/540.55, GERMANY
                --------------------------------------------

     ====================================================================

           As far as third party copyrights are not violated this
           source code is hereby placed to the public domain. Use
           it whatever way you want, but use AT YOUR OWN RISK.

           In case you should modify the source rather send your
           modifications to the unit's current organizer (see above for
           NM address) than to spread it on your own. This will help to
           keep the unit updated and grant a certain standard to all
           other users as well.

           The unit is currently still under work. So it might greatly
           benefit of your participation.

           Those who contributed to the following piece of source,
           listed in alphabethical order:
        ================================================================
           Bill Buchanan, Christian Clemens, Orazio Czerwenka, Bjorn
           Felten, Marcus Hardt, Mark Lewis, Max Maischein, Pawel
           Ostapczuk, Peter Schuette, Wolfram Sieber, ...
        ================================================================
           YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.

           Special thanks to Max Maischein for his kind permission to
            'exploit' his freeware collection of units 'SUX V. 1.0'.

           Credits in your own programs are as welcome as unnecessary.

 ***************************************************************************)

{$I FDEFINE.DEF}               { use the projects general conditional defines
                                 and compiler directives ... }

{$R-}                          { ... and use the unit's specific defines
                                 afterwards. }

Interface
Uses
  {$IFDEF CRT}
    CRT
  {$ENDIF}
  {$IFDEF FCRT}
  {$IFDEF CRT} , {$ENDIF}
    FCRT                        (* for hardware independent delay *)
  {$ENDIF}
    ;

const
  SoundsEnabled : boolean = TRUE;       {read/write }

{ overloaded CRT routines: }
procedure nosound;                      { replaces CRT's nosound }
procedure sound (hertz : word);         { replaces CRT's sound }

{ routines to save redunant code: }
Procedure SoundOff (DelayLen  : Word);  { Turns the sound off }
Procedure SoundOn  (Note, Tone,
                    DelayLen  : Word);  { Turns the sound on }

{ parameterless routines: }
Procedure Alarm;                        { Gives an alarming sound }
Procedure Beep;                         { Makes a beep }
Procedure Bell;                         { Bright sound }
procedure Bell2;                        { 9 * BipSound }
procedure Bip;                          { 1050 Hz, 30 ms }
Procedure Boop;                         { Makes a boop }
procedure Bop;                          { 50 Hz, 30 ms }
Procedure BuzzSaw;                      { Makes a buzzsawing sound }
procedure Car;
procedure ClecClac;
Procedure CloseWhistle;
Procedure ErrorBeep;                    { Another 'deep' sounding error beep }
procedure Explosion;
procedure Explosion2;
Procedure Falling;
procedure Falling2;
Procedure Fanfare;                      { The FroDo BeBiBoop }
procedure Flak;
procedure Gun;
Procedure HiRing;                       { simulates a phone's 'high' ringing }
procedure Laser;
Procedure LoRing;                       { simulates a phone's 'low' ringing }
Procedure MorseCode;                    { Makes some senseless morse code }
procedure MP;
procedure Mystic;
procedure Mystic2;
procedure Mystic3;
procedure Mystic4;
procedure Mystic5;
procedure Noname1;
procedure Noname2;
procedure Noname3;
procedure Noname4;
procedure Noname5;
procedure Noname6;
procedure Nuke;
Procedure OpenWhistle;
procedure Rain;
procedure RandomSound;
procedure SinusBeep;
procedure StartingCar;
Procedure TootTootToot;                 {3 times: 444 Hz, 34 ms
                                                    0 Hz, 34 ms}
Procedure Warning;
Procedure WindowsBeep;                  { A rather crude windows - wrong -
                                          key pressed - sound }
Procedure WrongSequence;                 { plays the 1st octave with swapped
                                           'g' and 'a' }
Procedure Zip1;                          { Makes a sound like ZZZZip }
Procedure Zip2;                          { Makes a sound like ZZZZiiip }

{ routines with parameters: }
Procedure Beam   (Heigth : Word);       { Makes a 'beam' sound }
procedure Ploing (step   : byte);       { Makes a sawing noise. }
Procedure Zap    (Key    : Word);       { Makes a sound like ZZZZaaap }

{----------------------------------------------------------------------------}

Implementation

{-overloaded CRT routines--------------------------------------------------1-}

procedure nosound; assembler;
{turns the speaker off}
{ Original author: Mark Lewis }
asm
  IN     AL,61h
  AND    AL,0FCh
  OUT    61h,AL
end;

{ -------------------------------------------------------------------------- }

procedure sound (hertz : word); Assembler;
{hertz is the sound frequency to send to the speaker port}
{ Original author: Mark Lewis }
asm
  MOV    BX,SP
  MOV    BX,&hertz
  MOV    AX,34DDh
  MOV    DX,0012h
  CMP    DX,BX
  JNB    @J1
  DIV    BX
  MOV    BX,AX
  IN     AL,61h
  TEST   AL,03h
  JNZ    @J2
  OR     AL,03h
  OUT    61h,AL
  MOV    AL,-4Ah
  OUT    43h,AL
@J2:
  MOV    AL,BL
  OUT    42h,AL
  MOV    AL,BH
  OUT    42h,AL
@J1:
end;

{-overloaded CRT routines--------------------------------------------------9-}

{-routines to save redunant code-------------------------------------------1-}

Procedure SoundOff ( DelayLen : Word );
{ Original author: Max Maischein
  Modified by Wolfram Sieber }
Begin
  NoSound;
  If NOT SoundsEnabled then exit;
  Delay( DelayLen );
End;

{ -------------------------------------------------------------------------- }

Procedure SoundOn ( Note, Tone, DelayLen : Word );
{ Original author: Max Maischein
  Modified by Wolfram Sieber }
Begin
  If NOT SoundsEnabled then exit;

  Sound( Note*Tone SHR 1 );
  Delay( DelayLen );
End;

{-routines to save redunant code-------------------------------------------9-}

{-sound effects------------------------------------------------------------1-}

Procedure Alarm;
{ Original author: Max Maischein
  Modified by Wolfram Sieber }
Var I : Byte;
Begin
  If NOT SoundsEnabled then exit;

  For I := 1 To 3 Do
  Begin
    SoundOn ( 1000,2,300 );
    SoundOn (  500,1,300 );
  End;
  NoSound;
End;

{ -------------------------------------------------------------------------- }

Procedure Beam ( Heigth : Word );
{ Original author: Max Maischein
  Modified by Wolfram Sieber }
Var I : Word;
Begin
  If NOT SoundsEnabled then exit;

  For I := 1 To Heigth Do
  Begin
    SoundOn ( I * 10, 1, 5 );
    SoundOff (5);
  End;
  For I := Heigth DownTo 1 Do
  Begin
    SoundOn ( I * 10, 1, 5 );
    SoundOff (5);
  End;
End;

{ -------------------------------------------------------------------------- }

Procedure Beep;
{ Original author: Max Maischein
  Modified by Wolfram Sieber }
Begin
  If NOT SoundsEnabled then exit;

  SoundOn (440,2,100);
  NoSound;
End;

{ -------------------------------------------------------------------------- }

Procedure Bell;
{ Original author: Max Maischein }
Begin
  If NOT SoundsEnabled then exit;

  SoundOn (660,1,100);
  NoSound;
End;

{ -------------------------------------------------------------------------- }

procedure Bell2;
{Original author: Wolfram Sieber}
const
  BellDelay = 30;
var
  i : byte;
begin
  If NOT SoundsEnabled then exit;

  for i:=1 to 9 do begin
    Bip;
    SoundOff (BellDelay)
  end
END;

{ -------------------------------------------------------------------------- }

procedure Bip;
{Original author: Wolfram Sieber}
begin
  If NOT SoundsEnabled then exit;

  SoundOn (1050, 1, 30);
  NoSound;
END;

{ -------------------------------------------------------------------------- }

Procedure Boop;
{ Original author: Max Maischein }
Begin
  If NOT SoundsEnabled then exit;

  SoundOn (220,2,100);
  NoSound;
End;

{ -------------------------------------------------------------------------- }

procedure Bop;
{Original author: Wolfram Sieber}
begin
  If NOT SoundsEnabled then exit;

  SoundOn (50, 1, 30);
  NoSound;
END;

{ -------------------------------------------------------------------------- }

Procedure BuzzSaw;
{ Original author: Max Maischein
  Modified by Wolfram Sieber }
Var I : Word;
Begin
  If NOT SoundsEnabled then exit;

  For I := 500 DownTo 1 Do
  Begin
    SoundOn ( I * 10, 1, 5 );
    SoundOff (5);
  End;
End;

{ -------------------------------------------------------------------------- }

procedure Car;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i:integer;
begin
  If NOT SoundsEnabled then exit;

  for i:=10 to 540 do
    SoundOn (round(1000*sin(i * 1 div 2)), 1, 1);
  nosound;
end;

{ -------------------------------------------------------------------------- }

procedure ClecClac;
{Original author: Wolfram Sieber}
const
  Clec = 250;
  Clac = 200;
begin
  If NOT SoundsEnabled then exit;

  SoundOff (1); SoundOn (Clec, 1, 55);
  SoundOff (1); SoundOn (Clac, 1, 55);
  NoSound;
END;

{ -------------------------------------------------------------------------- }

Procedure CloseWhistle;
{ Original author: Bill Buchanan
  Modified by Wolfram Sieber }
Var
  Frequency: Integer;
begin
  If SoundsEnabled then
    For Frequency := 1000 downto 500 do
    begin
      Delay(1);
      Sound(Frequency)
    end;
  NoSound
end;

{ -------------------------------------------------------------------------- }

Procedure ErrorBeep;
{ Original author: Peter Schuette }
Begin
  If NOT SoundsEnabled then exit;

  SoundOn(50,1,500);
  NoSound;
End;

{ -------------------------------------------------------------------------- }

procedure Explosion;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i: integer;
begin
  If NOT SoundsEnabled then exit;

  for i:=10 to 240 do
    SoundOn (round(500*sin(i * 1)), 1, 1);
  nosound;
end;

{ -------------------------------------------------------------------------- }

procedure Explosion2;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i: integer;
begin
  If NOT SoundsEnabled then exit;

  for i:=1000 downto 200 do
    SoundOn(random(i+100), 1, 2);
  nosound;
end;

{ -------------------------------------------------------------------------- }

Procedure Falling;
{ Original author: Max Maischein
  Modified by Wolfram Sieber }
Var I : Word;
Begin
  If NOT SoundsEnabled then exit;

  For I := 50 DownTo 20 Do
  Begin
    SoundOn  ( I * 10, 3, 50 );
    SoundOff ( 20 );
  End;
End;

{ -------------------------------------------------------------------------- }

procedure Falling2;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i: integer;
begin
  If NOT SoundsEnabled then exit;

  for i:=3000 downto 650 do
    SoundOn (i, 1, 1);
  nosound;
end;

{ -------------------------------------------------------------------------- }

Procedure Fanfare;
{ Original author: Max Maischein
  Modified by Wolfram Sieber }
Begin
  If NOT SoundsEnabled then exit;

  Bell;
  Beep;
  Boop;
End;

{ -------------------------------------------------------------------------- }

procedure flak;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i:integer;
begin
  If NOT SoundsEnabled then exit;

  delay(100);
  for i:=10 to 550 do
    SoundOn (round(1000*sin(i * 2)), 1, 1);
  nosound;
end;

{ -------------------------------------------------------------------------- }

procedure Gun;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i:integer;
begin
  If NOT SoundsEnabled then exit;

  for i:= 250 to 400 do
    SoundOn (random(4000-10*i)-50, 1, 1);
  nosound;
end;

{ -------------------------------------------------------------------------- }

Procedure HiRing;
{ Original author: Bjorn Felten,
  modifications Orazio Czerwenka,
  modification by Wolfram Sieber }
var i:word;
begin
  If NOT SoundsEnabled then exit;

  for i:=0 to 6 do
  begin
    soundon(523,2,50);
    soundon(659,2,50);
  end;
  nosound
end;

{ -------------------------------------------------------------------------- }

procedure Laser;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i:integer;
begin
  If NOT SoundsEnabled then exit;

  for i:= 0 to 500 do begin
    Sound (random(5500-10*i)-50);  {SoundOn is too slow}
    Delay (1);                     {to be used in this case}
  end;
  nosound;
end;

{ -------------------------------------------------------------------------- }

Procedure LoRing;
{ Original author: Bjorn Felten,
  modifications Orazio Czerwenka,
  modification by Wolfram Sieber }
var i:word;
begin
  If NOT SoundsEnabled then exit;

  for i:=0 to 6 do
  begin
    soundon(523,1,50);
    soundon(659,1,50);
  end;
  nosound
end;

{ -------------------------------------------------------------------------- }

Procedure MorseCode;
{ Original author: Max Maischein
  Modified by Wolfram Sieber }
Var I : Word;
Begin
  If NOT SoundsEnabled then exit;

  For I := 1 To 10 Do
  Begin
    SoundOn ( 600, 2, 100 );
    SoundOff ( 30 + Random (200) );
  End;
End;

{ -------------------------------------------------------------------------- }

procedure MP;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i:integer;
begin
  If NOT SoundsEnabled then exit;

  for i:= 250 to 290 do
    SoundOn (random(10*i)-60, 1, 1);
  nosound;
  delay(10);
end;

{ -------------------------------------------------------------------------- }

procedure Mystic;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i:integer;
begin
  If NOT SoundsEnabled then exit;

  for i:= 800 to 2000 do
    SoundOn (random(3*5000-4*10*i)-50, 1, 3);
  nosound;
end;

{ -------------------------------------------------------------------------- }

procedure Mystic2;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i:integer;
begin
  If NOT SoundsEnabled then exit;

  for i:= 800 to 2000 do begin
    SoundOn (random(3*5000-4*10*i)-50, 1, 2);
    SoundOn (5500-(i), 1, 1);
  end;
  nosound;
  delay(50);
  {for i:=10 to 250 do begin
     SoundOn (random(500+i*2)+500, 1, 2);
  end;}

  for i:=1000*2 downto 200*2 do
    SoundOn (random(i div (2+ i div 10000) +100), 1, 2);
  nosound;
end;

{ -------------------------------------------------------------------------- }

Procedure Mystic3;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i,x: Integer;
begin
  If NOT SoundsEnabled then exit;

  i:=30;
  x:=30;
  repeat
    SoundOn (i, 1, 1);
    SoundOn (x, 1, 2);
    inc(i,2);
    inc(x,4);
  until (x>5000) {or (keypressed)};
  Nosound;
end;

{ -------------------------------------------------------------------------- }

Procedure Mystic4;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i,x: Integer;
begin
  If NOT SoundsEnabled then exit;

  i:=30;
  x:=30;
  repeat
    SoundOn (i, 1, 1); Nosound;
    SoundOn (x, 1, 2); Nosound;
    inc(i,2);
    inc(x,4);
  until (x>5000) {or (keypressed)};
  Nosound;
end;

{ -------------------------------------------------------------------------- }

procedure Mystic5;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i: integer;
begin
  If NOT SoundsEnabled then exit;

  for i:=500 to 2700 do
    SoundOn (random(1000)+2*i-500, 1, 1);
  nosound;
end;

{ -------------------------------------------------------------------------- }

procedure Noname1;
{Original author: Wolfram Sieber}
var
  i : word;
begin
  If NOT SoundsEnabled then exit;

  for i:=1 to 17 do begin
    SoundOn (i*100, 1, 13);
    NoSound;
    SoundOn (1500, 1, 13);
    NoSound;
  end;
END;

{ -------------------------------------------------------------------------- }

procedure Noname2;
{Original author: Wolfram Sieber}
var
  i : word;
begin
  If NOT SoundsEnabled then exit;

  for i:=200 to 2500 do begin
    SoundOn (500, 1, 1);
    NoSound;
    SoundOn (i, 1, 1);
  end;
  nosound
END;

{ -------------------------------------------------------------------------- }

procedure Noname3;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i:integer;
begin
  If NOT SoundsEnabled then exit;

  for i:=0 to 1000 do
    SoundOn(i*i, 1, 1);
  nosound;
end;

{ -------------------------------------------------------------------------- }

procedure Noname4;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i:integer;
begin
  If NOT SoundsEnabled then exit;

  for i:=0 to 1000 do
    SoundOn (i mod 100, 1, 1);
  nosound;
end;

{ -------------------------------------------------------------------------- }

procedure Noname5;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i,a:integer;
begin
  If NOT SoundsEnabled then exit;

  for i:=0 to 10 do begin
    a:=a+500;
    SoundOn (a, 1, 10);
  end;
  nosound;
end;

{ -------------------------------------------------------------------------- }

procedure Noname6;
{ Original author: Christian Clemens
  Modified by Wolfram Sieber }
var i,c : byte;
    hz : word;
begin
  If NOT SoundsEnabled then exit;

  for c:=1 to 3 do
   for i:=1 to 100 do
    begin
     hz := i*180+100;
     SoundOn ( hz, 1, 5);
     nosound;
    end;
end;

{ -------------------------------------------------------------------------- }

Procedure Nuke;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i:integer;
begin
  If NOT SoundsEnabled then exit;

  for i:= 0 to 5000 do begin
    nosound;
    SoundOn (random(50+i)-50, 1, 3);
  end;
  nosound;
end;

{ -------------------------------------------------------------------------- }

Procedure OpenWhistle;
{ Original author: Bill Buchanan
  Modified by Wolfram Sieber }
Var
  Frequency : Integer;
begin
  If NOT SoundsEnabled then exit;

  For Frequency := 500 to 1000 do
  begin
    Delay(1);
    Sound(Frequency)
  end;
  NoSound
end;

{ -------------------------------------------------------------------------- }

procedure Ploing (step : byte);
{Original author: Wolfram Sieber}
var       {Fine "Step"s: 10..2}
  i : byte;
begin
  If NOT SoundsEnabled then exit;

  For i:=1 to 100 do begin
    SoundOn (i*10, 1, Step);
    NoSound;
  end;
END;

{ -------------------------------------------------------------------------- }

Procedure Rain;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
begin
  If NOT SoundsEnabled then exit;

  SoundOn (Random(30)+20, 1, 3);
  SoundOff (Random(200));
end;

{ -------------------------------------------------------------------------- }

procedure RandomSound;
{Original author: Wolfram Sieber}
var
  i : byte;
begin
  If NOT SoundsEnabled then exit;

  for i:=1 to 24 do begin
    SoundOn  ((random (3)+1)*222, 1, 10);
    SoundOff (75);
  end
END;

{ -------------------------------------------------------------------------- }

procedure SinusBeep;
{ Original author: Pawel Ostapczuk
  Modified by Wolfram Sieber }
var i:integer;
begin
  If NOT SoundsEnabled then exit;

  for i:= 0 to 5 do
    SoundOn (round(2000*sin(1000*i))-100, 1, 20);
  nosound;
end;

{ -------------------------------------------------------------------------- }

procedure StartingCar;
{Original author: Wolfram Sieber}
var
  i : byte;
begin
  If NOT SoundsEnabled then exit;

  for i:=30 to 120 do begin
    SoundOn (i, 1, 50);
    nosound
  end;
END;

{ -------------------------------------------------------------------------- }

procedure TootTootToot;
{Original author: Wolfram Sieber}
const
  TootDelay = 34;
var
  i : byte;
begin
  If NOT SoundsEnabled then exit;

  for i:=1 to 3 do begin
    SoundOn (444, 1, TootDelay);
    SoundOff (TootDelay)
  end
END;

{ -------------------------------------------------------------------------- }

Procedure Warning;
{ Original author: Christian Clemens
  Modified by Wolfram Sieber }
Var X : Byte;
Begin
  If NOT SoundsEnabled then exit;

  For X := 1 To 3 Do
   Begin
    Sound ( 125 ); Delay ( 50 ); NoSound;
    Delay ( 25 );
   End;
End;

{ -------------------------------------------------------------------------- }

Procedure WindowsBeep;
{ Original author: Max Maischein
  Modified by Wolfram Sieber }
Begin
  If NOT SoundsEnabled then exit;

  SoundOn( 860,2,30 );
  SoundOn( 660,2,15 );
  NoSound;
End;

{ -------------------------------------------------------------------------- }

procedure WrongSequence;
{Original author: Wolfram Sieber}
var
  Note : byte;
  Octave : array [1..7] of byte;
begin
  If NOT SoundsEnabled then exit;

  Octave [1] := 131; {instead of normally 130.81 Hz}
  Octave [2] := 147; {instead of normally 146.83 Hz}
  Octave [3] := 165; {instead of normally 164.81 Hz}
  Octave [4] := 175; {instead of normally 174.61 Hz}
  Octave [6] := 196;
  Octave [5] := 220;
  Octave [7] := 247; {instead of normally 246.94 Hz}
  for Note := 1 to 7 do begin
    SoundOn (round (Octave [Note]), 1, 50);
    SoundOff (30);
  end;
END;

{ -------------------------------------------------------------------------- }

Procedure Zap( Key : Word );
{ Original author: Max Maischein
  Modified by Wolfram Sieber }
VAR I,J,K,L : Word;
Begin
  If NOT SoundsEnabled then exit;

  For I := 1 To 11 Do
  Begin
    J := 1 * 23 + ( 51 - Random ( Key ) );
    For K := 1 To 5 Do
    Begin
      For L := 1 To 37 - K * 2 Do Sound ( ( L+J+K*2)*3 Div 2 );
      Delay ( Key );
      Inc ( J , 31 );
    End;
  End;
  NoSound ;
End;

{ -------------------------------------------------------------------------- }

procedure Zip1;
{Original author: Wolfram Sieber}
var
  i : byte;
begin
  If NOT SoundsEnabled then exit;

  for i:=1 to 150 do
    SoundOn (i*100, 1, 1);
  nosound
END;

{ -------------------------------------------------------------------------- }

procedure Zip2;
{Original author: Wolfram Sieber}
var
  i : byte;
begin
  If NOT SoundsEnabled then exit;

  for i:=1 to 150 do begin
    SoundOn (i*100, 1, 1);
    nosound;
  end;
END;

{-sound effects------------------------------------------------------------9-}

(* procedure InitFSPEAKER;
begin
  EnableSpeaker;
end;

{$IFOPT O-}
Begin
  InitFSPEAKER;
{$ENDIF} *)
End.